home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / graftxt.com / GTXTDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-06  |  9.8 KB  |  335 lines
  1. {$I+}    {I/O checking on}
  2. program GtxtDemo;      {Fast display of Text in Graphics mode.}
  3.                        {works on horizontal 8 pixel boundaries }
  4.                        {For EGA/VGA only - Bugs/problems/sugesstions welcomed!}
  5.                        {Author: Tim Godfrey, 72617,2125 }
  6.                        {Previous version loaded Fonts as .OBJ files into TPU }
  7.                        { Version 27 Jan 89 }
  8.                        {Fixed bug in ASMs causing eventual stack overflow}
  9.                        {Added SetYOfset to allow "Pseudo Paging" for EGA modes}
  10.                        {to write on second page, just add 350 to Y coordinates}
  11.                        { Version 1 Feb 89 }
  12.                        {Added true paging support of SetActivePage and }
  13.                        { SetVisualPage from the Graph Unit}
  14.  
  15.                        { Version 7 Jul 89 }
  16.                        { Added new Procedure SetGfont, eliminating requirement
  17.                        { of passing the font data with every procedure call}
  18.                        { Improved optimization of assembler }
  19.                        { Added Pitch variable to support pixels per line other }
  20.                        { than 640. Pitch is number of _bytes_ per scan line}
  21.  
  22.  
  23. Uses
  24.   Crt,Graph,graftext,break;
  25.  
  26. type
  27.    hstype        =   string[2];
  28.    filenametype  =   string[24];
  29.  
  30. var
  31.    err,fchar,xline,idx      :   integer;
  32.    teststr                  :   string;
  33.    resxstr,resystr          :   string[10];
  34.    rowaray                  :   array [0..255] of byte;
  35.    dot,fpix,lentxtpix       :   integer;
  36.    maxtextlines             :   integer;
  37.    akey                     :   char;
  38.    numstr                   :   string[10];
  39.    z,yofs,startaddr           :   word;
  40.  
  41. {----------------Graphics Support Section--------------------}
  42.  
  43.  
  44. const
  45.   { The names of the various device drivers supported }
  46.   DriverNames : array[0..10] of string[8] =
  47.   ('Detect', 'CGA', 'MCGA', 'EGA', 'EGA64', 'EGAMono',
  48.    'RESERVED', 'HercMono', 'ATT400', 'VGA', 'PC3270');
  49.  
  50.   { The five fonts available }
  51.   Fonts : array[0..4] of string[13] =
  52.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  53.  
  54.   { The five predefined line styles supported }
  55.   LineStyles : array[0..4] of string[9] =
  56.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  57.  
  58.   { The twelve predefined fill styles supported }
  59.   FillStyles : array[0..11] of string[14] =
  60.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  61.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  62.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  63.  
  64.   { The two text directions available }
  65.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  66.  
  67.   { The Horizontal text justifications available }
  68.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  69.  
  70.   { The vertical text justifications available }
  71.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  72.  
  73. var
  74.   GraphDriver : integer;  { The Graphics device driver }
  75.   GraphMode   : integer;  { The Graphics mode value }
  76.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  77.   ErrorCode   : integer;  { Reports any graphics errors }
  78.   MaxColor    : word;     { The maximum color value available }
  79.   OldExitProc : Pointer;  { Saves exit procedure address }
  80.   textx,texty : word;
  81.  
  82. {$F+}
  83. procedure MyExitProc;
  84. begin
  85.   ExitProc := OldExitProc; { Restore exit procedure address }
  86.   CloseGraph;              { Shut down the graphics system }
  87. end; { MyExitProc }
  88. {$F-}
  89.  
  90. procedure Initialize;
  91. { Initialize graphics and report any errors that may occur }
  92. begin
  93.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  94.   DirectVideo := False;
  95.   OldExitProc := ExitProc;                { save previous exit proc }
  96.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  97. if (paramcount>0) and ((paramstr(1)='/V') or (paramstr(1)='/v')) then begin
  98.   GraphDriver := VGA;
  99.   graphmode := VGAHi;
  100.   end
  101. else if (paramcount>0) and ((paramstr(1)='/E') or (paramstr(1)='/e')) then begin
  102.  
  103.   GraphDriver := EGA;
  104.   graphmode := EGAHi;
  105.   end
  106.  
  107.   else
  108.   graphdriver := detect;
  109.  
  110.   InitGraph(GraphDriver, graphmode,'..');  { activate graphics }
  111.   ErrorCode := GraphResult;               { error? }
  112.   if ErrorCode <> grOk then
  113.   begin
  114.     Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  115.     writeln('Note - as written, this program expects to find EGAVGA.BGI in the');
  116.     writeln('parent of the current directory. A /V parameter will force VGA mode.');
  117.  
  118.     Halt(1);
  119.   end;
  120.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  121.   MaxX := GetMaxX;          { Get screen resolution values }
  122.   MaxY := GetMaxY;
  123. end; { Initialize }
  124.  
  125.  
  126. type hexstr = string[10];
  127.  
  128. function Hex(Number:Integer;Bytes:integer):hexstr;
  129.  
  130. const
  131.   T : array[0..15] of char = '0123456789ABCDEF';
  132.  
  133. var
  134.   D : integer;
  135.   H : hexstr;
  136.  
  137. begin H[0]:=chr(bytes+bytes);
  138.  for D:=bytes+bytes downto 1 do begin
  139.    H[D]:=T[number and 15];
  140.    Number:=Number shr 4;
  141.  end;
  142.  Hex:=H;
  143. end;
  144.  
  145.  
  146.  
  147.  
  148. {_______________________________________________________}
  149.  
  150. {-----------------Mainline Program-----------------------}
  151.  
  152.  
  153. begin
  154.  
  155. teststr := 'This is a test 01234567890 (8x8 font) ';
  156.  
  157. Initialize;  {graphics activation}
  158.  
  159. maxtextlines := (Maxy div 8) -1;
  160. str(1+maxx,resxstr);
  161. str(1+maxy,resystr);
  162. teststr := resxstr+'x'+resystr+' test 01234567890 (8x8 font) ';
  163.  
  164.  
  165. setfillStyle(widedotfill,darkgray);
  166.  
  167.  
  168. Bar(0,0,Maxx,Maxy);
  169.  
  170. SetGfont(Thin8);
  171.  
  172. for idx := 0 to 15 do
  173.    Gtxtsol(8,(9*idx),blue,idx,teststr);
  174. for idx := 0 to 15 do
  175.    Gtxtsol(8,(MaxY div 2)+(9*idx),red,idx,teststr);
  176. for idx := 0 to 15 do
  177.    Gtxtsol(10+(MaxX div 2),(9*idx),green,idx,teststr);
  178. for idx := 0 to 15 do
  179.    Gtxtsol(10+(MaxX div 2),(MaxY div 2)+(9*idx),darkgray,idx,teststr);
  180.  
  181.  
  182.    Akey := readkey;
  183.  
  184.  
  185. {----------------------------------}
  186.  
  187. Bar(0,0,Maxx,Maxy);
  188.  
  189. SetGfont(Thin14);
  190. teststr := resxstr+'x'+resystr+' test 01234567890 (8x14 font) ';
  191.  
  192. for idx := 0 to 7 do
  193.    Gtxtsol(8,(15*idx),blue,idx,teststr);
  194. for idx := 0 to 7 do
  195.    Gtxtsol(8,(MaxY div 3)+(15*idx),red,idx,teststr);
  196. for idx := 0 to 7 do
  197.    Gtxtsol(10+(MaxX div 2),(15*idx),green,idx,teststr);
  198. for idx := 0 to 7 do
  199.    Gtxtsol(10+(MaxX div 2),(MaxY div 3)+(15*idx),darkgray,idx,teststr);
  200. for idx := 0 to 7 do
  201.    Gtxttran(8,(2*(MaxY div 3))+(15*idx),idx,teststr);
  202. for idx := 0 to 7 do
  203.    Gtxttran(10+(MaxX div 2),(2*(MaxY div 3))+(15*idx),8+idx,teststr);
  204.  
  205.  
  206. Akey := readkey;
  207.  
  208. GtxtSol(0,450,blue,white,'Scrolled image. This line is 450, top is 350');
  209.  
  210. for yofs := 0 to 350 do begin   {use loop here to make scrolling visible}
  211.     delay(2);
  212.     SetYofset(yofs);
  213.     end;
  214.  
  215. Akey := readkey;
  216.  
  217. for yofs :=  349 downto 0 do begin        {Smooth scroll back down}
  218.     delay(2);
  219.     SetYofset(yofs);
  220.     end;
  221.  
  222. Akey := readkey;
  223. Bar(0,0,Maxx,Maxy);
  224. setactivepage(1);
  225. setvisualpage(1);
  226.  
  227. setfillStyle(ltbkSlashFill,darkgray);
  228. Bar(0,0,Maxx,Maxy);
  229. setcolor(green);
  230. line(0,0,maxx,maxy);
  231. GtxtSol(0,10,blue,white,'Now on second page using SetActivePage(1)');
  232. GtxtSol(8,100,blue,white,'BIOS buffer addr = '+hex(mem[$40:$4E],1));
  233. GtxtSol(8,200,blue,white,'BIOS vid.page addr= '+hex(mem[$40:$62],1));
  234. If maxy>350 then begin
  235.     GtxtSol(0,300,blue,white,'As you can see, there aren''t two');
  236.     GtxtSol(0,315,blue,white,'independant pages available in');
  237.     GtxtSol(0,330,blue,white,'480 line graphic modes');
  238.     GtxtSol(0,345,blue,white,'Run GTXTDEMO with /E switch');
  239.     GtxtSol(0,360,blue,white,'To see paging at EGA 350 lines');
  240.  
  241.     end;
  242.  
  243.  
  244.  
  245. Akey := readkey;
  246. setactivepage(0);
  247. setvisualpage(0);
  248. GtxtSol(0,50,blue,white,'Now on first page using SetActivePage(0)');
  249. GtxtSol(8,100,blue,white,'BIOS buffer addr = '+hex(mem[$40:$4E],1));
  250. GtxtSol(8,200,blue,white,'BIOS vid.page addr= '+hex(mem[$40:$62],1));
  251. Akey := readkey;
  252.  
  253.  
  254. {rapidly alternate between pages}
  255. if maxy <= 350 then
  256.   for z := 1 to 12 do begin
  257.     delay(12);
  258.     setvisualpage(1);
  259.     delay(12);
  260.     setvisualpage(0);
  261.     end;
  262.  
  263.  
  264. teststr := 'These lines use GtxtSol for speed';
  265. setfillStyle(widedotfill,darkgray);
  266. Bar(0,0,Maxx,Maxy);
  267.  
  268. SetGfont(Thin8);
  269. for idx := 0 to maxtextlines do
  270.    GtxtSol(8,(8*idx),black,idx mod 15,teststr);
  271.  
  272. teststr := 'These lines use OutTextXY ..slower.';
  273.  
  274. setfillstyle(solidfill,black);
  275. for idx := 0 to maxtextlines do  begin
  276.    setcolor(idx mod 15);                      {separate command to set color}
  277.    bar((MaxX div 2),(8*idx),(MaxX div 2)+textwidth(teststr),(8*idx)+textheight(teststr));
  278.                                                         {clear background}
  279.    outtextxy((MaxX div 2),(8*idx),teststr);                      {write the string}
  280.    end;
  281.  
  282.  
  283. Akey := readkey;
  284.  
  285. setfillStyle(widedotfill,darkgray);
  286. teststr := 'These lines use GtxtTran for speed';
  287. Bar(0,0,Maxx,Maxy);
  288.  
  289. setfillstyle(solidfill,green);
  290. bar(0,0,maxx div 16,maxy);
  291. setfillstyle(solidfill,red);
  292. bar(maxx div 16,0,maxx div 8,maxy);
  293. setfillstyle(solidfill,blue);
  294. bar(maxx div 8,0,3*maxx div 16,maxy);
  295. setfillstyle(solidfill,darkgray);
  296. bar(3*maxx div 16,0,maxx div 4,maxy);
  297.  
  298.  
  299.  
  300. for idx := 0 to maxtextlines do
  301.    Gtxttran(8,(8*idx),idx mod 15,teststr);
  302.  
  303. teststr := 'These lines use OutTextXY ..slower.';
  304.  
  305.  
  306. for idx := 0 to maxtextlines do  begin
  307.    setcolor(idx mod 15);
  308.    outtextxy((MaxX div 2),(8*idx),teststr);
  309.    end;
  310.  
  311.  
  312. Akey := readkey;
  313.  
  314. setfillStyle(SOLIDfill,BLACK);
  315. teststr := 'Various Fonts can be BINOBJ''ed and added';
  316. Bar(0,0,Maxx,Maxy);
  317.  
  318. SetGfont(Brdwy19);
  319. for idx := 0 to 5 do
  320.    Gtxttran(0,(20*idx),idx+2,teststr);
  321.  
  322. SetGfont(Sans19);
  323. for idx := 0 to 5 do
  324.    Gtxttran(100,(maxy div 3)+(20*idx),idx+2,teststr);
  325.  
  326. SetGfont(Wndw19);
  327. for idx := 0 to 5 do
  328.    Gtxttran(200,(maxy div 3)*2+(20*idx),idx+2,teststr);
  329.  
  330.  
  331. Akey := readkey;
  332.  
  333. CloseGraph;
  334. end.
  335.